home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / WINPROGS / SPMATE12.ZIP / SPELMATE.BA$ / spelmate.bas
BASIC Source File  |  1993-10-01  |  5KB  |  146 lines
  1. Option Explicit
  2.  
  3. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++
  4. '                                                      +
  5. ' SpelChek.BAS.   (c) A.McMonnies/MEDC, 1993.          +
  6. ' +++++++++++++++++++++++++++++++++++++++++++          +
  7. ' This is a small library demonstrating the use of the +
  8. ' seriously cool SPELLMATE spell checker library       +
  9. ' from James Heron's Acrian Software Products.         +
  10. ' It includes Visual Basic declarations of the SPELMATE+
  11. ' library functions, a declaration for IsCharAlpha from+
  12. ' the Windows User.DLL library (very useful) and some  +
  13. ' small functions which help to parse strings of text  +
  14. ' for spell checking.                                  +
  15. ' The module can be used to do a simple parse of       +
  16. ' strings of text, or to include a spell check.        +
  17. ' To check spelling, call SetSpellOn from your program +
  18. ' (which should incorporate this module in the Project +
  19. ' file), and then call DoSpellCheck(), passing the     +
  20. ' string to be examined as a parameter.  e.g......               +
  21. '                                                      +
  22. '   Dim s$                                             +
  23. '      s$ = "Check the spelling of the word speling."  +
  24. '      SetSpellOn                                      +
  25. '      Parse(s$)                                       +
  26. '                                                      +
  27. ' If you do not need to check spelling, do not use     +
  28. ' SetSpellOn, or call SetSpellOff to disable checking. +
  29. '+++++++++++++++++++++++++++++++++++++++++++++++++++++++
  30.  
  31. ' Alphanumeric id function...
  32. Declare Function IsCharAlpha% Lib "User" (ByVal cChar%)
  33.  
  34. ' Spellmate functions...
  35. Declare Function SpelMateInit Lib "spelmate.dll" () As Integer
  36. Declare Function SpellCheck Lib "spelmate.dll" (ByVal AWord As String) As Integer
  37. Declare Function AddWord Lib "spelmate.dll" (ByVal AWord As String) As Integer
  38. Declare Sub IgnoreWord Lib "spelmate.dll" (ByVal AWord As String)
  39. Declare Sub SuggestVBWord Lib "spelmate.dll" (ByVal AWord As String)
  40.  
  41. Sub DoSpellCheck (T As TextBox)
  42. ' Reduce input text to a list of unique text strings
  43. ' and check the spelling of each.
  44. Dim Wd$, W As String * 20, ok%, ip%
  45. Dim Start%
  46.     ok% = SpelMateInit()
  47.     If Not ok% Then
  48.         MsgBox "Spellmate has not initialised.", 0, "Spell Check"
  49.         Exit Sub
  50.     End If
  51.     If Len((T.Text)) > 0 Then
  52.         Start% = T.SelStart
  53.     Else
  54.         Exit Sub
  55.         MsgBox "No text to check.", 0, "Spell Check"
  56.     End If
  57.     Do
  58.         Wd$ = Trim$(GetWord$((T.Text), Start%))
  59.         If Wd$ = "" Then
  60.             T.SelLength = 0
  61.             T.SelStart = Len((T.Text))
  62.             Exit Do  ' No more words.
  63.         Else
  64.             ' Set select area to highlight word...
  65.             T.SetFocus
  66.             T.SelStart = Start% - 1
  67.             T.SelLength = Len(Wd$)
  68.             ' Now check it's spelling...
  69.             W = Wd$ & Chr$(0)
  70.             ok% = SpellCheck(Wd$)
  71.             If ok% = 0 Then
  72.                 SuggestVBWord W
  73.                 If Asc(Left$(W, 1)) = 0 Then
  74.                     Exit Do  ' A NULL
  75.                 End If
  76.                 ip% = InStr(W, Chr$(0))
  77.                 If (ip% > 0) And (Wd$ <> Left$(W, ip% - 1)) Then
  78.                     Wd$ = Left$(W, ip% - 1)
  79.                     T.SelText = Wd$
  80.                 End If
  81.             End If
  82.         Start% = Start% + Len(Wd$)
  83.         End If
  84.     Loop
  85. End Sub
  86.  
  87. Function GetWord$ (InText$, StartPos%)
  88. ' Function returns the next word in InText$, starting at
  89. ' StartPos%, or "" if StartPos% is past last word.
  90. Dim L%, WdLen%, c As String * 1, FinPos%
  91.     L% = Len(InText$)
  92.     ' Is InText$ empty, or is StartPos% past it's end?
  93.     If L% = 0 Or StartPos% > L% Then
  94.         GetWord$ = ""
  95.         Exit Function
  96.     End If
  97.  
  98.     ' Find the start of the next word...
  99.     If StartPos% < 1 Then
  100.         StartPos% = 1
  101.     End If
  102.     Do Until IsCharAlpha%(Asc(Mid$(InText$, StartPos%, 1)))
  103.         StartPos% = StartPos% + 1
  104.         ' Check we've not overrun the end of Intext$...
  105.         If StartPos% > L% Then
  106.             GetWord$ = ""
  107.             Exit Function
  108.         End If
  109.     Loop
  110.  
  111.     ' We're at the start, find the end...
  112.     FinPos% = StartPos% + 1
  113.     Do While FinPos% <= L%
  114.         If IsWordChar%(Mid$(InText$, FinPos%, 1)) Then
  115.             FinPos% = FinPos% + 1
  116.         Else
  117.             Exit Do
  118.         End If
  119.     Loop
  120.     ' Adjust for a possessive single quote...
  121.     If Mid$(InText, FinPos% - 1, 1) = "'" Then
  122.         FinPos% = FinPos% - 1
  123.     End If
  124.     WdLen% = FinPos% - StartPos%
  125.  
  126.     ' Now extract the word...
  127.     GetWord$ = Trim$(Mid$(InText$, StartPos%, WdLen%))
  128.     ' StartPos% = FinPos% + 1
  129. End Function
  130.  
  131. Function IsWordChar% (c$)
  132. Dim r%
  133.     r% = IsCharAlpha%(Asc(c$))
  134.     If r% Then
  135.         IsWordChar% = True
  136.         Exit Function
  137.     Else
  138.         If c$ = "'" Then
  139.             IsWordChar% = True
  140.             Exit Function
  141.         End If
  142.     End If
  143.     IsWordChar% = r%
  144. End Function
  145.  
  146.